Attribute VB_Name = "HookWheel"
Option Explicit

Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const SPI_GETWHEELSCROLLLINES = 104
Private Const WM_MOUSEWHEEL = &H20A
Private WHEEL_SCROLL_LINES As Long
Private lProc As Long

Private vsc As VScrollBar

Public Sub Hook(ByVal hwnd As Long, v_vsc As VScrollBar)
    Set vsc = v_vsc
    lProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHook(ByVal hwnd As Long)
    Dim r As Long
    r = SetWindowLong(hwnd, GWL_WNDPROC, lProc)
    Set vsc = Nothing
End Sub

Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MW_FB As Integer
    Dim k As Integer
    
    If uMsg = WM_MOUSEWHEEL Then
        If vsc.Visible Then
            MW_FB = (wParam And &HFFFF0000) \ &H10000
            
            k = (vsc.Value - Sgn(MW_FB) * vsc.LargeChange)
            If k > vsc.Max Then
                k = vsc.Max
            End If
            
            If k < vsc.Min Then
                k = vsc.Min
            End If
            vsc.Value = k
        End If
    End If
    WindowProc = CallWindowProc(lProc, hw, uMsg, wParam, lParam)
End Function
